Clickx 22

home *** CD-ROM | disk | FTP | other *** search

/ Clickx 22 / Clickx 22.iso / DATA / amc_install.exe / {app} / Scripts / MrCinemaCinefilCommon.pas < prev next >

Wrap

Pascal/Delphi Source File | 2005-04-06 | 16.9 KB | 393 lines

unit MrCinemaCinefilCommon; (*************************************************** partie commune aux scripts MrCinema et Cinefil nΘcessite les modules StringUtils7552.pas et StringUtils1.pas version 1.1 ***************************************************) uses StringUtils7552; const cinefil_id = 0; // identifiants mrcinema_id = 1; // CinefilBase = 'http://www.cinefil.com'; CinefilUrl = CinefilBase + '/cinefil2005/'; { recherche: les films sont triΘs par annΘe (dΘcroissante)} CinefilUrlLook = CinefilUrl + 'CFM_Recherches/films.cfm?lachaine2='; var // note FormatUTF8 est dΘclarΘ dans StringUtils7552 (integer) filmok, debug: Boolean; MovieName, firstcall, abort, batchlogfic, debugrep, msgano: string; batchlog, confbatch: TstringList; calledBy, BatchMode, FormatTitre: integer; bestpoids, maxcount, pagemax: Integer; PageNext, PagePrev, bestadr, besttxt, lookreal, lookmovie, looktxt: String; //------------------------------------------------------------------------------ // recherche du film (cinΘfil) // MovieName = nom du film cherchΘ (tel que saisi, cad non formatΘ) //------------------------------------------------------------------------------ procedure AnalyzePageCinefil; var Address, Page, Line, Value, PageFilm, urlfilm: string; pagenum, i: integer; memo: TStringList; begin pagenum := 0; // compteur de pages // init adresse 1Φre recherche Address := CinefilUrlLook+FormatMovieName3(MovieName); repeat // traitement page courante PageNext := ''; PagePrev := ''; pagenum := pagenum + 1; FormatUTF8 := 0; memoAdr := TStringList.Create; // init liste de mΘmo memoTxt := TStringList.Create; Page := GetPage(UrlEncode(Address)); if debug then DumpPage(debugrep+'choixCinefil'+IntToStr(pagenum)+'.txt', Page); // debug Page := TextAfter(Page, ' RΘsultat '); // infos utiles if Page = '' then begin LogMessage('CinΘfil: erreur lecture page de recherche '+IntToStr(pagenum)); // non trouvΘ = erreur memoAdr.Free; memoTxt.Free; exit; end; // recherche pages prΘcΘdente et suivante Line := TextBefore(Page, '</TD>', ''); // Line = url's << < page1 page2 ... > >> Page := RemainingText; if Pos('HREF', AnsiUpperCase(Line)) = 0 then Line := ''; // 1 seule page while Line <> '' do begin Value := TextBefore(Line, '/a>', ''); // Value = url page xxx Delete(Line, 1, Pos('</a>', Line)+4); // Line = les suivantes // ignorer les "retours rapides" (<< et >>) pour ne pas confondre avec < et > if Pos('><<<', Value) > 0 then continue; if Pos('>>><', Value) > 0 then continue; if Pos('><<', Value) > 0 then begin // Value = url page prΘcΘdente PagePrev := GetUrl(Value, '', CinefilBase); memoAdr.Add(PagePrev); memoTxt.Add('<<< page prΘcΘdente'); end; if Pos('>><', Value) > 0 then PageNext := GetUrl(Value, '', CinefilBase); // Value = url page suivante end; {while line <> ''} // mΘmo des films de cette page urlfilm := 'HREF=''../fichefilm.cfm?ref='; memo := TStringList.Create; memo.Text := StringReplace(Page, '</TR>', crlf); // separe lignes for i := 0 to memo.Count-1 do begin Line := memo.GetString(i); PageFilm := GetUrl(Line, urlfilm, CinefilUrl); if PageFilm = '' then continue; // pas d'url = autre chose ou ligne vide memoAdr.Add(PageFilm); // sΘparer le rΘalisateur du reste avant HTMLRemoveTags Line := StringReplace(Line, '</a>', sepchar1); // aprΦs le titre memoTxt.Add(FormatText(Line)); // [annΘe] nom du film sepchar1 de rΘalisateur end; {for i} memo.Free; if PageNext <> '' then begin memoAdr.Add(PageNext); memoTxt.Add('>>> page suivante'); end; if memoAdr.Count = 0 then begin LogMessage('CinΘfil: aucun film trouvΘ pour "'+MovieName+'"'); memoAdr.Free; memoTxt.Free; exit; end; if BatchMode > 0 then begin // mode batch : recherche du meilleur poids pour les films de cette page LookBest(cinefil_id); if (bestpoids = maxcount) or (PageNext = '') or (pagenum > pagemax) then // poids max ou pas de page next ou max pages lues: on arrΩte begin if bestpoids > 0 then // on a trouvΘ quelque chose begin if bestpoids < maxcount then // infos partielles LogMessage('CinΘfil: '+looktxt+' retenu '+besttxt+' (poids='+IntToStr(bestpoids)+')'); AnalyzePageFilmCinefil(bestadr); // page film end else LogMessage('CinΘfil: pas de correspondance pour '+looktxt); break; // on sort end else // sinon, on va chercher s'il y a mieux dans pagenext Address := PageNext; end else begin // mode normal Address := SelectMovie('Films (CinΘfil)'); if Address <> '' then begin if (Address <> PageNext) and (Address <> PagePrev) then begin AnalyzePageFilmCinefil(Address); // page film break; // on sort end; end else LogMessage('CinΘfil: aucun film sΘlectionnΘ'); end; until (Address = ''); memoAdr.Free; memoTxt.Free; end; //------------------------------------------------------------------------------ // analyse de la page du film (CinΘfil) //------------------------------------------------------------------------------ procedure AnalyzePageFilmCinefil(Address: string); var Page, Table, Value, Value2: string; BeginPos: Integer; begin FormatUTF8 := 0; Page := GetPage(Address); if debug then DumpPage(debugrep+'filmCinefil.txt', Page); // debug Page := TextAfter(Page, 'RΘfΘrence film cinefil'); // vire le dΘbut if Page = '' then Begin LogMessage('CinΘfil: erreur lecture page film'); exit; end; filmok := True; // τa y est, c'est bon if calledBy = cinefil_id then SetField(fieldURL, Address); if CanSetPicture then begin // affiche: test s'il y a un grand format Value := TextBetween(Page, 'javascript:ZoomPhoto(''', ''''); if Value = '' then // sinon test s'il y a un petit format Value := TextBetween(Page, '<IMG class=photo SRC=''', ''''); if Value <> '' then GetPicture(Value) else begin if (calledBy <> cinefil_id) then begin Value := 'CinΘfil: pas d''affiche prΘvue pour "'+MovieName+'"'; if BatchMode > 0 then LogMessage(Value) else ShowInformation(Value); end; end; end; {CanSetPicture} if calledBy = mrcinema_id then exit; // MrCinΘma: affiche uniquement // pays annΘe et durΘe Value := TextBetween(Page, '', ' '); Page := RemainingText; Value := StringReplace(Value, '- ', sepchar1); // sΘpare les champs Value := FormatText(Value); // supprime les tags Value2 := Trim(TextBefore(Value, sepchar1, '')); // pays (plusieurs possibles) Value := RemainingText; SetField(fieldCountry, Value2); Value2 := Trim(TextBefore(Value, sepchar1, '')); // annΘe Value := RemainingText; SetField(fieldYear, Value2); Value2 := Trim(TextBefore(Value, sepchar1, '')); // durΘe heuresHminutes BeginPos := Pos('H', AnsiUpperCase(Value2)); Value2 := IntToStr(StrToInt(Left(Value2, BeginPos-1), 0) * 60 + StrToInt(Copy(Value2, BeginPos+1, 2), 0)); SetField(fieldLength, Value2); // titre original ou traduit Value := TextBetween(Page, '', ''); Page := RemainingText; Value := FormatText(Value); // titre original Θventuel Value2 := FormatText(TextBetween(Page, ' Titre original : ', '')); Value2 := TranslateText(Value2, FormatTitre); Value := TranslateText(Value, FormatTitre); if (Value2 = '') or (Value = Value2) then // 1er titre = original begin SetField(fieldOriginalTitle, Value); SetField(fieldTranslatedTitle, ''); end else begin // traduit + original Page := RemainingText; SetField(fieldOriginalTitle, Value2); SetField(fieldTranslatedTitle, Value); end; // catΘgorie et rΘalisateur (un/une catΘgorie de rΘalisateur) Value := TextBetween(Page, ' ', ' '); Page := RemainingText; Value2 := FormatText(TextAfter(Value, '')); // rΘalisateur(s) SetField(fieldDirector, Value2); Value := FormatText(TextBefore(Value, '', '')); // un/une catΘgorie(s) BeginPos := Pos('UN', AnsiUpperCase(Value)); // virer l'article if BeginPos = 1 then begin BeginPos := Pos(' ', Value); Delete(Value, 1, BeginPos); end; BeginPos := LastPos('DE', AnsiUpperCase(Value)); // virer 'de' if BeginPos > 0 then Value := Left(Value, BeginPos -1); SetField(fieldCategory, Trim(Value)); // acteurs Value := TextBefore(Page, '<TABLE BORDER=0><TR><TD>', ''); Page := RemainingText; Value := FormatText(TextBetween(Value, 'avec', crlf)); SetField(fieldActors, Value); // description Value := FormatText(TextBefore(Page, '</TABLE>', '')); SetField(fieldDescription, Value); end; //------------------------------------------------------------------------------ // recherche du film correspondant α lookmovie/lookreal (mode batch) // mΘmorisation de bestpoids, bestadr et besttxt //------------------------------------------------------------------------------ procedure LookBest(id: integer); var Value, Address, realisateur, name: string; filmnum, poids, i: integer; begin // rechercher dans la liste mΘmorisΘe le nom du film/rΘalisateur demandΘ // attention: memoTxt. dΘjα passΘ dans FormatText donc plus de tags et en ascii for filmnum := 0 to memoTxt.Count -1 do begin Address := memoAdr.GetString(filmnum); if (Address = PageNext) or (Address = PagePrev) then continue; // sauf page prev/next Value := memoTxt.GetString(filmnum); if id = cinefil_id then // fiche CinΘfil begin // [annΘe] nom du film de rΘalisateur name := TextBetween(Value, ']', sepchar1); // nom du film realisateur := RemainingText; // de rΘalisateur(s) realisateur := TextAfter(realisateur, 'de'); end else begin // fiche MrCinema name := TextBefore(Value, sepchar1 , ''); // nom du film Value := RemainingText; // de rΘalisateur (annΘe facultative) realisateur := TextAfter(Value, 'de'); // attention: pas de TextBetween Value := TextBefore(realisateur, '(', ''); if Value <> '' then realisateur := Value; end; realisateur := FormatRealisateur(realisateur); // rΘalisateur (peut Ωtre '') name := CleanString(name); // nom du film // poids rΘalisateur(s) // ignorer si poids = 0 et les 2 champs non vides poids := CompareWords(lookreal, realisateur); if (lookreal = '') or (realisateur = '') or (poids > 0) then begin // + (poids du film)x1000 // on refuse poids(rΘalisateur) = 0 si nom du film approximatif (poids <> 100) i := CompareWords(lookmovie, name); if (poids > 0) or (i = 100) then poids := poids + (i * 1000); end; if (poids > 1000) and (poids > bestpoids) then // rΘsultat des courses // il faut quand mΩme qu'il y ait au moins 1 mot du titre !!! begin // courant = meilleur bestpoids := poids; bestadr := Address; besttxt := '"'+StringReplace(memoTxt.GetString(filmnum), sepchar1, '')+'"'; if bestpoids = maxcount then break; // exact match: inutile de continuer end; end; {for filmnum} end; //------------------------------------------------------------------------------ // initialisations pour batch mode (nom+rΘalisateur) //------------------------------------------------------------------------------ procedure initBatchLook; begin lookreal := GetField(fieldDirector); // rΘalisateur(s) peut Ωtre '' lookmovie := MovieName; // nom du film looktxt := '"'+lookmovie+'/'+lookreal+'"'; // pour les messages lookreal := FormatRealisateur(lookreal); // formatages lookmovie := CleanString(lookmovie); bestpoids := 0; // init meilleur poids maxcount := 100100; // poids maximum pagemax := 2; // lire au maximum 3 pages bestadr := ''; // mΘmo adresse page trouvΘe besttxt := ''; // et nom du film/rΘalisateur end; //------------------------------------------------------------------------------ // formatage realisateur //------------------------------------------------------------------------------ function FormatRealisateur(str: string) :string; begin str := CleanString(str); // supprimer les 'et' pour ne garder que les noms // ce serait dommage de sΘlectionner une fiche parce qu'il y a seulement 'et' en commun ! str := StringReplace(str, ' et ', ' '); str := StringReplace(str, ' & ', ' '); result := str; end; //------------------------------------------------------------------------------ // valorisation de msgano (mode normal) ou ajout dans la log (mode batch) //------------------------------------------------------------------------------ procedure LogMessage(m: string); begin if BatchMode > 0 then AddToLog('fiche '+GetField(fieldNumber)+': '+m) else msgano := m; end; //------------------------------------------------------------------------------ // initialisation de la log //------------------------------------------------------------------------------ procedure initBatchLog; begin batchlog := TStringList.Create; batchlog.Add('dΘmarrage mode batch'); batchlog.Add('poids = xxxyyy avec xxx poids du nom du film et yyy poids du rΘalisateur'); batchlog.Add('chaque poids = pourcentage du nombre de mots cherchΘs/trouvΘs'); batchlog.Add('100 = correspondance exacte'); batchlog.Add(StringOfChar('*',80)); batchlog.SaveToFile(batchlogfic); // message pour confirmation confbatch := TStringList.Create; confbatch.Add('Vous avez sΘlectionnΘ le mode batch:'); confbatch.Add('Avez-vous sauvegardΘ votre base?'); confbatch.Add(''); confbatch.Add('En fin de traitement:'); confbatch.Add('- consultez le fichier '+batchlogfic+' pour les erreurs/infos'); confbatch.Add('- les films trouvΘs seront cochΘs, les autres non (pour la sΘlection)'); confbatch.Add(' (voir: outils/prΘfΘrences/liste des films/cases α cocher)'); confbatch.Add(''); confbatch.Add('confirmez votre choix'); end; //------------------------------------------------------------------------------ // ajoute un message dans la log et sauvegarde sur disque // (parce que je ne sais pas quand τa finit...) //------------------------------------------------------------------------------ procedure AddToLog(m: string); begin batchlog.Add(m); batchlog.SaveToFile(batchlogfic); end; //------------------------------------------------------------------------------ // formatage du nom du film (CinΘfil) //------------------------------------------------------------------------------ function FormatMovieName3(str: string) :string; begin // une petite Θdition avant de formater str := StringReplace(str, ' & ', ' et '); // remplacer les apostrophes, tirets et points par des blancs str := StringReplace(str, '''', ' '); str := StringReplace(str, '.', ' '); str := StringReplace(str, '-', ' '); result := FormatMovieName(str); end; end.